home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / egavga.swg / 0179_360x256x256 Tweaked Mode.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-03-26  |  9.4 KB  |  318 lines
  1. {
  2.      Hi Kai.  I read your message about 360x256x256 and saw you were using
  3. Tweak.  This is message 1/2 which includes Pascal versions of Twkuser.c
  4. and Tweak2c.  Thought they might be helpful to you.
  5.  
  6. Maurice L. Marvin
  7. maurice@cs.pdx.edu
  8. }
  9.  
  10. {$I-}
  11. UNIT TWKUSER;
  12.  
  13. {=========================================================================
  14.   TWKUSER.PAS is a Borland Pascal 7.0 compatible unit for using Robert
  15.   Schmidt's TWEAK generated files.
  16.  
  17.   Ported to Pascal from Robert Schmidt's original C code.
  18.  
  19.   Donated to public domain.
  20.  
  21.   Maurice L. Marvin
  22.   maurice@cs.pdx.edu
  23.  ==========================================================================}
  24.  
  25. INTERFACE
  26.  
  27.  CONST
  28.  
  29.     { xxxxADDR defines the base port number used to access VGA
  30.       component xxxx, and is defined for xxxx =
  31.            ATTRCON    -   Attribute Controller
  32.            MISC       -   Miscellaneous Register
  33.            VGAENABLE  -   VGA Enable Register
  34.            SEQ        -   Sequencer
  35.            GRACON     -   Graphics Controller
  36.            CRTC       -   Cathode Ray Tube Controller
  37.            STATUS     -   Status Register }
  38.  
  39.     ATTRCON_ADDR        = $3C0;
  40.     MISC_ADDR           = $3C2;
  41.     VGAENABLE_ADDR      = $3C3;
  42.     SEQ_ADDR            = $3C4;
  43.     GRACON_ADDR         = $3CE;
  44.     CRTC_ADDR           = $3D4;
  45.     STATUS_ADDR         = $3DA;
  46.  
  47.  TYPE
  48.  
  49.     Register = RECORD
  50.                   port   : WORD;
  51.                   index  : BYTE;
  52.                   value  : BYTE;
  53.                END;
  54.  
  55.     RegisterPtr = ^Register;
  56.  
  57. PROCEDURE ReadyVgaRegs;
  58. PROCEDURE OutReg(r : Register);
  59. PROCEDURE OutRegArray(r : RegisterPtr;
  60.                       n : INTEGER);
  61. FUNCTION  LoadRegArray(fpath        : STRING;
  62.                        VAR RegArray : RegisterPtr) : INTEGER;
  63.  
  64.  
  65. IMPLEMENTATION
  66.  
  67.  
  68. {--------------------------------------------------------------------------
  69.   ReadyVGARegs does the initialization to make the VGA ready to accept
  70.   any combination of configuration register settings.
  71.  
  72.   This involves enabling writes to index 0 to 7 of the CRT controller
  73.   (port $3d4), by clearing the most significant bit (bit 7) of index
  74.   $11.
  75.  --------------------------------------------------------------------------}
  76.  
  77. PROCEDURE ReadyVGARegs;
  78.  
  79.  VAR
  80.  
  81.     v : BYTE;
  82.  
  83.  BEGIN {*** Begin procedure ReadyVGARegs ***}
  84.     Port[$3d4] := $11;
  85.     v := Port[$3d5] AND $7f;
  86.     Port[$3d4] := $11;
  87.     Port[$3d5] := v;
  88.  END;  {*** End procedure ReadyVGARegs ***}
  89.  
  90.  
  91. {--------------------------------------------------------------------------
  92.   OutReg sets a single register according to the contents of the passed
  93.   Register structure.
  94.  --------------------------------------------------------------------------}
  95.  
  96. PROCEDURE OutReg(r : Register);
  97.  
  98.  VAR
  99.  
  100.     v : BYTE;
  101.  
  102.  BEGIN {*** Begin procedure OutReg ***}
  103.     CASE (r.port) OF
  104.        ATTRCON_ADDR   : BEGIN
  105.                            v := Port[STATUS_ADDR]; { Reset read/write flip flop
  106. }                           Port[ATTRCON_ADDR] := r.index OR $20;
  107.                            { Ensure VGA output is enabled }
  108.                            Port[ATTRCON_ADDR] := r.value;
  109.                         END;
  110.        MISC_ADDR,
  111.        VGAENABLE_ADDR : BEGIN
  112.                            Port[r.port] := r.value; { Directly to the port }
  113.                         END;
  114.        ELSE { Default method }
  115.                         BEGIN
  116.                            Port[r.port] := r.index; { Index to port }
  117.                            Port[r.port + 1] := r.value; { Value to port + 1}
  118.                         END;
  119.     END;
  120.  END;  {*** End procedure OutReg ***}
  121.  
  122.  
  123. {--------------------------------------------------------------------------
  124.   OutRegArray sets n registers according to the array pointed to by r.
  125.   First, indexes 0-7 of the CRT controller are enabled for writing.
  126.  --------------------------------------------------------------------------}
  127.  
  128. PROCEDURE OutRegArray(r : RegisterPtr;
  129.                       n : INTEGER);
  130.  
  131.  VAR
  132.  
  133.     s : WORD;
  134.  
  135.  BEGIN {*** Begin procedure OutRegArray ***}
  136.     s := SizeOf(Register);
  137.     ReadyVGARegs;
  138.     WHILE (n > 0) DO
  139.        BEGIN
  140.           OutReg(r^);
  141.           ASM { Increment pointer to next record }
  142.              MOV DX,s
  143.              ADD WORD PTR [r],DX
  144.           END;
  145.           DEC(n);
  146.        END;
  147.  END;  {*** End procedure OutRegArray ***}
  148.  
  149.  
  150. {--------------------------------------------------------------------------
  151.   LoadRegArray opens the given file, does some validity checking, then
  152.   reads the entire file into an array of Registers, which is returned
  153.   via the RegArray parameter.
  154.  
  155.   You will probably want to provide your own error handling code in this
  156.   function, as it never aborts the program, rather than just printing
  157.   an error message and returning NULL.
  158.  
  159.   The returned value is the number of registers read.  The RegArray
  160.   parameter is set to the allocated register array.
  161.  
  162.   If you use this function, remember to dispose the returned array pointer,
  163.   as it was allocated dynamically using GetMem (unless NULL is returned,
  164.   which designates an error).
  165.  --------------------------------------------------------------------------}
  166.  
  167. FUNCTION LoadRegArray(fpath        : STRING;
  168.                       VAR RegArray : RegisterPtr) : INTEGER;
  169.  
  170.  VAR
  171.  
  172.     handle : FILE;
  173.     fsize  : LONGINT;
  174.  
  175.  BEGIN {*** Begin function LoadRegArray ***}
  176.     LoadRegArray := 0;
  177.     RegArray := NIL;
  178.     ASSIGN(handle,fpath);
  179.     RESET(handle,1);
  180.     IF (IOResult <> 0) THEN { error opening file ? }
  181.        BEGIN
  182.           { include error handling code here }
  183.           Exit;
  184.        END;
  185.     fsize := FileSize(handle);
  186.     IF (IOResult <> 0) THEN { error acquiring file size ? }
  187.        BEGIN
  188.           CLOSE(handle);
  189.           Exit;
  190.        END;
  191.     IF (fsize MOD SizeOf(Register) <> 0) THEN { Is filesize multiple of record
  192. ? }       BEGIN
  193.           WriteLn('Illegal TWEAK file size: ',fpath);
  194.           CLOSE(handle);
  195.           Exit;
  196.        END;
  197.     IF (MaxAvail < fsize) THEN { Is there enough memory ? }
  198.        BEGIN
  199.           WriteLn('Out of memory allocating buffer for ',fpath);
  200.           CLOSE(handle);
  201.           Exit;
  202.        END;
  203.     GetMem(RegArray,fsize);
  204.     BlockRead(handle,RegArray^,fsize);
  205.     IF (IOResult <> 0) THEN { Error reading file ? }
  206.        BEGIN
  207.           CLOSE(handle);
  208.           Dispose(RegArray);
  209.           RegArray := NIL;
  210.           Exit;
  211.        END;
  212.     CLOSE(handle);
  213.     IF (IOResult <> 0) THEN { Error closing file ? }
  214.        BEGIN
  215.           Dispose(RegArray);
  216.           RegArray := NIL;
  217.           Exit;
  218.        END;
  219.     LoadRegArray := fsize DIV SizeOf(Register);
  220.  END;  {*** End function LoadRegArray ***}
  221.  
  222.  
  223. END.
  224.  
  225.  
  226.  
  227.  
  228. {$I-}
  229. PROGRAM TWEAK2P;
  230.  
  231. USES TWKUSER;
  232.  
  233. {=========================================================================
  234.   TWEAK2P version 1.0
  235.  
  236.   Ported to Pascal from Robert Schmidt's original C code.
  237.  
  238.   Converts a TWEAK version 1.0 file to an include-able Pascal file,
  239.   defining the equivalent register array, which is passable
  240.   to the OutRegArray function defined in the TWKUSER unit.
  241.  
  242.   Maurice L. Marvin
  243.   maurice@cs.pdx.edu
  244.  =========================================================================}
  245.  
  246. VAR
  247.  
  248.    table   : RegisterPtr;
  249.    btable  : RegisterPtr;
  250.    regsize : INTEGER;
  251.    handle  : TEXT;
  252.    b1      : BYTE;
  253.    b2      : BYTE;
  254.    s       : WORD;
  255.  
  256. BEGIN {*** Begin program TWEAK2P ***}
  257.    { Check command line arguments. }
  258.    IF (ParamCount < 3) THEN
  259.       BEGIN
  260.          WriteLn;
  261.          WriteLn('TWEAK2P version 1.0');
  262.          WriteLn('Converts a TWEAK version 1.x file to an include-able Pascal
  263. file.');         WriteLn;
  264.          WriteLn('SYNTAX: TWEAK2P <TWEAK-File> <Pascal File to Create> <Array
  265. Name>');         WriteLn('All Parameters are required.');
  266.          Halt(1);
  267.       END;
  268.    { Load the register file. }
  269.    regsize := LoadRegArray(ParamStr(1),table);
  270.    { Save a pointer to the start of the table.  The pointer 'table' will
  271.      be corrupted due to pointer arithmetic. }
  272.    btable := table;
  273.    { Check if we loaded the table successfully. }
  274.    IF (Table = NIL) THEN
  275.       BEGIN
  276.          WriteLn;
  277.          WriteLn('ERROR : Unable to load register file.');
  278.          Halt(1);
  279.       END;
  280.    { Open the destination file. }
  281.    ASSIGN(handle,ParamStr(2));
  282.    REWRITE(handle);
  283.    IF (IOResult <> 0) THEN { Check if error creating file. }
  284.       BEGIN
  285.          WriteLn;
  286.          WriteLn('ERROR : Unable to create destination file.');
  287.          Halt(1);
  288.       END;
  289.    { Write data structure }
  290.    WriteLn(handle,'{ Tweaked include file generated by TWEAK2P } ');
  291.    WriteLn(handle,'');
  292.    WriteLn(handle,'CONST');
  293.    WriteLn(handle);
  294.    Write(handle,'   ',ParamStr(3),' : ARRAY[1..',RegSize);
  295.    WriteLn(handle,'] OF Register = (');
  296.    Write(handle,'       ');
  297.    s := SizeOf(Register);
  298.    { Write register values }
  299.    WHILE (RegSize > 0) DO
  300.       BEGIN
  301.          Write(handle,'(Port : ',table^.port);
  302.          Write(handle,'; Index : ',table^.index);
  303.          Write(handle,'; Value : ',table^.value,')');
  304.          DEC(RegSize);
  305.          IF (RegSize = 0) THEN
  306.             WriteLn(handle,');')
  307.          ELSE
  308.             WriteLn(handle,',');
  309.          ASM { move to next record }
  310.             MOV DX,s
  311.             ADD WORD PTR [table],DX
  312.          END;
  313.          Write(handle,'       ');
  314.       END;
  315.    CLOSE(handle);
  316.    Dispose(btable);
  317. END. {*** End program Tweak2P ***}
  318.